home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / PROGTOOL / FGL304F.ZIP;1 / EXFOR.ARJ / FGDOC / EXAMPLES / FORTRAN / FISHTANK.FOR < prev   
Encoding:
Text File  |  1994-01-24  |  10.1 KB  |  304 lines
  1. C************************************************************************
  2. C
  3. C  FISHTANK.FOR -- This program demonstrates multi-object non-destructive
  4. C  animation.  The coral background is displayed on page 2 and copied to
  5. C  page 0, the visual page.  A packed pixel run file containing the 6 fish
  6. C  is displayed on page 1, and then FG_GETIMAGE is used to load the fish
  7. C  into the fish bitmaps.
  8. C
  9. C  To make the fish move, the background is copied to page 1 and the fish
  10. C  are put over the background using FG_CLPIMAGE and FG_FLPIMAGE.  The
  11. C  fish are clipped at the edge of the screen.  Page 1 is then copied to
  12. C  page 0 using FG_COPYPAGE.  This process is then repeated in a loop.
  13. C
  14. C  To compile this program and link it with Fastgraph version 3.xx:
  15. C
  16. C     FL /FPi /4I2 /4Nt /AM FISHTANK.FOR /link FGM
  17. C
  18. C  This program also can be linked with Fastgraph/Light (version 3.02 or
  19. C  later) if you replace the FGM library reference with FGLM.
  20. C
  21. C  For more examples of animation using Fastgraph, or for an evaluation
  22. C  copy of Fastgraph/Light, call DDBBS at (702) 796-7134.  For Fastgraph
  23. C  voice support, call Ted Gruber Software at (702) 735-1980.
  24. C
  25. C************************************************************************
  26.  
  27. $INCLUDE: 'C:\FG\INTRFACE.FOR'
  28.  
  29.       PROGRAM MAIN
  30.       IMPLICIT INTEGER (A-Z)
  31.  
  32.       COMMON /SEED/ SEED
  33.  
  34. C *** fish bitmaps ***
  35.  
  36.       INTEGER*1 FISHES
  37.       COMMON /MAPS/ FISHES(5356), OFFSET(6)
  38.  
  39. C *** palette values
  40.  
  41.       INTEGER*2 COLORS(16)
  42.       DATA COLORS /0,1,2,3,4,5,6,7,16,0,18,19,20,21,22,23/
  43.  
  44. C *** make sure the system supports video mode 13 with 4 pages
  45.  
  46.       IF (FG_TESTMODE(13,4) .EQ. 0) THEN
  47.          WRITE(6,*)
  48.          WRITE(6,*) 'This program requires an EGA or VGA card'
  49.          WRITE(6,*) 'with at least 128k.  If an EGA card is'
  50.          WRITE(6,*) 'present, it must be the active adapter.'
  51.          STOP ' '
  52.       END IF
  53.  
  54. C *** initialize the video environment
  55.  
  56.       OLD_MODE = FG_GETMODE()
  57.       CALL FG_SETMODE(13)
  58.       CALL FG_PALETTES(COLORS)
  59.       CALL RANDOMIZE
  60.  
  61. C *** get the coral background from a file and put it on page 2
  62.  
  63.       CALL FG_SETPAGE(2)
  64.       CALL FG_MOVE(0,199)
  65.       CALL FG_DISPFILE('CORAL.PPR'//CHAR(0),320,1)
  66.  
  67. C *** copy the background from page 2 to page 0, the visual page
  68.  
  69.       CALL FG_COPYPAGE(2,0)
  70.  
  71. C *** get the fish
  72.  
  73.       CALL GET_FISH
  74.  
  75. C *** make the fish go
  76.  
  77.       CALL GO_FISH
  78.  
  79. C *** restore the original video state
  80.  
  81.       CALL FG_SETMODE(OLD_MODE)
  82.       CALL FG_RESET
  83.  
  84.       STOP ' '
  85.       END
  86.  
  87. C************************************************************************
  88. C*                                                                      *
  89. C*            get_fish -- fill up the fish bitmap arrays                *
  90. C*                                                                      *
  91. C************************************************************************
  92.  
  93.       SUBROUTINE GET_FISH
  94.       IMPLICIT INTEGER (A-Z)
  95.  
  96.       INTEGER*1 FISHES
  97.       COMMON /MAPS/ FISHES(5356), OFFSET(6)
  98.       COMMON /SIZE/ FISH_X1(6), FISH_Y1(6), WIDTH(6), HEIGHT(6)
  99.  
  100. C *** get the fish from a file and put them on page 1
  101.  
  102.       CALL FG_SETPAGE(1)
  103.       CALL FG_MOVE(0,199)
  104.       CALL FG_DISPFILE('FISH.PPR'//CHAR(0),320,1)
  105.  
  106. C *** build the fish bitmaps
  107.  
  108.       I = 1
  109.       DO 10 FISH_NUM = 1,6
  110.          CALL FG_MOVE(FISH_X1(FISH_NUM),FISH_Y1(FISH_NUM))
  111.          CALL FG_GETIMAGE(FISHES(I),WIDTH(FISH_NUM),HEIGHT(FISH_NUM))
  112.          OFFSET(FISH_NUM) = I
  113.          I = I + WIDTH(FISH_NUM) * HEIGHT(FISH_NUM)
  114. 10    CONTINUE
  115.  
  116.       RETURN
  117.       END
  118.  
  119. C************************************************************************
  120. C*                                                                      *
  121. C*             go_fish -- make the fish swim around                     *
  122. C*                                                                      *
  123. C************************************************************************
  124.  
  125.       SUBROUTINE GO_FISH
  126.       IMPLICIT INTEGER (A-Z)
  127.  
  128. C     There are 11 fish total, and 6 different kinds of fish.  These
  129. C     arrays keep track of what kind of fish each fish is, and how each
  130. C     fish moves:
  131. C
  132. C     fish()   -- which fish bitmap applies to this fish?
  133. C     x()      -- starting x coordinate
  134. C     y()      -- starting y coordinate
  135. C
  136. C     xmin()   -- how far left (off screen) the fish can go
  137. C     xmax()   -- how far right (off screen) the fish can go
  138. C     xinc()   -- how fast the fish goes left and right
  139. C     dir()    -- starting direction for each fish
  140. C
  141. C     ymin()   -- how far up this fish can go
  142. C     ymax()   -- how far down this fish can go
  143. C     yinc()   -- how fast the fish moves up or down
  144. C     yturn()  -- how long fish can go in the vertical direction
  145. C               before stopping or turning around
  146. C     ycount() -- counter to compare to yturn
  147.  
  148.       PARAMETER (NFISH = 11)
  149.  
  150.       INTEGER*1 KEY, AUX
  151.  
  152.       INTEGER*1 FISHES
  153.       COMMON /MAPS/ FISHES(5356), OFFSET(6)
  154.  
  155.       INTEGER FISH(NFISH), X(NFISH), Y(NFISH)
  156.       INTEGER XMIN(NFISH), XMAX(NFISH), XINC(NFISH)
  157.       INTEGER YMIN(NFISH), YMAX(NFISH), YINC(NFISH)
  158.       INTEGER DIR(NFISH), YTURN(NFISH), YCOUNT(NFISH)
  159.  
  160.       DATA FISH /   2,   2,   3,   4,   4,   1,   1,   6,   5,   3,   4/
  161.       DATA X    /-100,-150,-450,-140,-200, 520, 620,-800, 800, 800,-300/
  162.       DATA Y    /  40,  60, 150,  80,  70, 190, 180, 100,  30, 130,  92/
  163.  
  164.       DATA XMIN /-300,-300,-800,-200,-200,-200,-300,-900,-900,-900,-400/
  165.       DATA XMAX / 600, 600,1100,1000,1000, 750, 800,1200,1400,1200, 900/
  166.       DATA XINC /   2,   2,   8,   5,   5,  -3,  -3,   7,  -8,  -9,   6/
  167.       DATA DIR  /   0,   0,   0,   0,   0,   1,   1,   0,   1,   1,   0/
  168.  
  169.       DATA YMIN /  40,  60, 120,  70,  60, 160, 160,  80,  30, 110,  72/
  170.       DATA YMAX /  80, 100, 170, 110, 100, 199, 199, 120,  70, 150, 122/
  171.       DATA YTURN/  50,  30,  10,  30,  20,  10,  10,  10,  30,   20, 10/
  172.       DATA YCOUNT/  0,   0,   0,   0,   0,   0,   0,   0,   0,   0,   0/
  173.       DATA YINC /   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,   0/
  174.  
  175. C *** make the fish swim around
  176.  
  177. 10    CONTINUE
  178.  
  179. C *** copy the background from page 2 to page 1
  180.  
  181.       CALL FG_COPYPAGE(2,1)
  182.  
  183. C *** put all the fish on the background
  184.  
  185.       DO 20 I = 1,11
  186.  
  187.          CALL FG_SETPAGE(1)
  188.          YCOUNT(I) = YCOUNT(I) + 1
  189.          IF (YCOUNT(I) .GT. YTURN(I)) THEN
  190.             YCOUNT(I) = 0
  191.             YINC(I) = IRANDOM(-1,1)
  192.          END IF
  193.          Y(I) = Y(I) + YINC(I)
  194.          Y(I) = MIN(YMAX(I),MAX(Y(I),YMIN(I)))
  195.  
  196.          IF (X(I) .GE. 0 .AND. X(I) .LT. 320) THEN
  197.             CALL PUT_FISH(FISH(I),X(I),Y(I),DIR(I))
  198.          ELSE IF (X(I) .LT. 0 .AND. X(I) .GT. -72) THEN
  199.             CALL FG_TRANSFER(0,71,0,199,104,199,1,3)
  200.             CALL FG_SETPAGE(3)
  201.             CALL PUT_FISH(FISH(I),X(I)+104,Y(I),DIR(I))
  202.             CALL FG_TRANSFER(104,175,0,199,0,199,3,1)
  203.          END IF
  204.          X(I) = X(I) + XINC(I)
  205.          IF (X(I) .LE. XMIN(I) .OR. X(I) .GE. XMAX(I)) THEN
  206.             XINC(I) = -XINC(I)
  207.             DIR(I) = 1 - DIR(I)
  208.          END IF
  209.  
  210. 20    CONTINUE
  211.  
  212. C *** copy page 1 to page 0
  213.  
  214.       CALL FG_SETPAGE(0)
  215.       CALL FG_COPYPAGE(1,0)
  216.  
  217. C *** intercept a keystroke, if it is escape exit the program
  218.  
  219.       CALL FG_INTKEY(KEY,AUX)
  220.       IF (KEY .NE. 27) GO TO 10
  221.  
  222.       RETURN
  223.       END
  224.  
  225. C************************************************************************
  226. C*                                                                      *
  227. C*                irandom -- random number generator                    *
  228. C*                                                                      *
  229. C************************************************************************
  230.  
  231.       FUNCTION IRANDOM(MIN,MAX)
  232.       IMPLICIT INTEGER (A-Z)
  233.  
  234.       TEMP = IEOR(SEED,ISHFT(SEED,-7))
  235.       SEED = IAND(IEOR(ISHFT(TEMP,8),TEMP),#7FFF)
  236.       IRANDOM = MOD(SEED,MAX-MIN+1) + MIN
  237.  
  238.       RETURN
  239.       END
  240.  
  241. C************************************************************************
  242. C*                                                                      *
  243. C*      put_fish -- draw one of the six fish anywhere you want          *
  244. C*                                                                      *
  245. C************************************************************************
  246.  
  247.       SUBROUTINE PUT_FISH(FISH_NUM,X,Y,FISH_DIR)
  248.       IMPLICIT INTEGER (A-Z)
  249.  
  250.       INTEGER*1 FISHES
  251.       COMMON /MAPS/ FISHES(5356), OFFSET(6)
  252.       COMMON /SIZE/ FISH_X1(6), FISH_Y1(6), WIDTH(6), HEIGHT(6)
  253.  
  254. C *** move to position where the fish will appear
  255.  
  256.       CALL FG_MOVE(X,Y)
  257.  
  258. C *** draw a left- or right-facing fish, depending on fish_dir
  259.  
  260.       I = OFFSET(FISH_NUM)
  261.       IF (FISH_DIR .EQ. 0) THEN
  262.          CALL FG_FLPIMAGE(FISHES(I),WIDTH(FISH_NUM),HEIGHT(FISH_NUM))
  263.       ELSE
  264.          CALL FG_CLPIMAGE(FISHES(I),WIDTH(FISH_NUM),HEIGHT(FISH_NUM))
  265.       END IF
  266.  
  267.       RETURN
  268.       END
  269.  
  270. C************************************************************************
  271. C*                                                                      *
  272. C*       randomize -- get a seed for the random number generator        *
  273. C*                                                                      *
  274. C************************************************************************
  275.  
  276.       SUBROUTINE RANDOMIZE
  277.       IMPLICIT INTEGER (A-Z)
  278.  
  279.       COMMON /SEED/ SEED
  280.  
  281.       INTEGER*4 FG_GETCLOCK
  282.  
  283.       SEED = IAND(INT(FG_GETCLOCK()),#7FFF)
  284.  
  285.       RETURN
  286.       END
  287.  
  288. C************************************************************************
  289. C*                                                                      *
  290. C*      block data -- initialize arrays in common blocks                *
  291. C*                                                                      *
  292. C************************************************************************
  293.  
  294.       BLOCK DATA
  295.       IMPLICIT INTEGER (A-Z)
  296.  
  297.       COMMON /SIZE/ FISH_X1(6), FISH_Y1(6), WIDTH(6), HEIGHT(6)
  298.       DATA FISH_X1 /  0, 64,128,200,  0, 80/
  299.       DATA FISH_Y1 /199,199,199,199,150,150/
  300.       DATA WIDTH   / 28, 27, 34, 28, 31, 34/
  301.       DATA HEIGHT  / 25, 38, 26, 30, 22, 36/
  302.  
  303.       END
  304.